home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / oper_sys / oasis / ossxmpls.lha / examples / Tsp.old < prev    next >
Encoding:
Text File  |  1992-04-04  |  6.6 KB  |  133 lines
  1. /*======================================================================================================
  2.         Auxiliary  Data  Structures:  task and map
  3. ======================================================================================================*/
  4. class task {                                            # task structure
  5.     attribute:
  6.     public      int*       c1, c2;                      # all cities
  7.                 int*       tour;                        # partial tour
  8.                 int        sum;                         # partial sum
  9. }
  10.  
  11. class map {
  12.     attribute:
  13.     public      int        size;                        # matrix size
  14.                 int[_,_]   dist;                        # distance matrix
  15.     private     int        x = 197;                     # random number seed
  16.     method:
  17.     public      gen        (int I; int* ?Cities).
  18.     private     loop       (int I, J).
  19. }
  20.  
  21. map {
  22.     gen(size, []).
  23.     gen(I', [I|Cs]) |- loop(I,I+1); gen(I+1, Cs').      # go thru rows
  24.  
  25.     loop(_, size).
  26.     loop(I', J') |-                                     # go thru columns
  27.         x' = (4757 * x + 1) % 32768;
  28.         (int) B' = 1 + ((x / 16) % 256);                # random number
  29.         dist[I,J]' = B;                                 # initialize (i,j)
  30.         dist[J,I]' = B;                                 # symmetric (j,i)
  31.         loop(I, J+1).
  32. }
  33.  
  34. /*======================================================================================================
  35.         Tsp  Specifications
  36. ======================================================================================================*/
  37. class Tsp[$done] {                                      # Tsp agent specification
  38.     attribute:
  39.     public      Tsp        parent = nil;                # parent agent
  40.                 int[_,_]   dist   = nil;                # distance matrix
  41.                 int*       best   = [];                 # best tour so far
  42.                 int        min    = 65536;              # minimum distance so far
  43.                 int        qsize  = 0;                  # task count in queue
  44.                 task*      queue  = [];                 # task queue
  45.                 int        depth  = 2;                  # search depth before spawn
  46.     protected   int        count  = 34;                 # queue length threshold
  47.     method:
  48.     public      get        (task  ?Task; int* ?Tour; int ?Sum).
  49.     protected   run        (task* Queue).
  50.     private     spawn      (int   Count).
  51.     protected   explore    (int*  C1, C2, Tour; int Sum, Depth).
  52.                 expand     (int*  C1, C2, Tour; int Sum, Depth).
  53.     public      update     (int*  Tour; int Sum).
  54.                 ask        (int*  ?Tour; int ?Sum).
  55. }
  56.  
  57. Tsp :: TspAgent {
  58.     method:
  59.     public      work       ().
  60. }
  61.  
  62. Tsp :: Root {
  63.     method:
  64.     public      do         (int[_,_] Dist; int Depth, Count; int* ?Best; int ?Min).
  65. }
  66.  
  67. /*======================================================================================================
  68.         Tsp  Implementations
  69. ======================================================================================================*/
  70. Tsp {                                                   # Tsp agent implementation
  71.     get(_,best,min)  :- queue == []; $done ! post(1).   # queue empty? wakeup!
  72.     get(X,best,min)  :- (task*) [X'|queue'] = queue;    # dequeue task
  73.                         X.sum < min.                    # task looks ok?
  74.     get(X,best,min)  |- get(X',_,_).                    # no, skip to next task
  75.  
  76.     run([X'|queue']) :- (task) task{C1',C2',T',S'} = X; # extract task properties
  77.                         explore(C1,C2,T,S,depth);       # do search
  78.                         qsize < count;                  # below threshold?
  79.                         run(queue).                     # work till all finished
  80.     run([_|_])       |- spawn(qsize/count);             # over threshold, spawn
  81.                         $done ! wait(qsize/count).      # wait till all finished
  82.     run([]).                                            # all done!
  83.  
  84.     spawn(0).                                           # no more children!
  85.     spawn(I') |- (task*) [X'|queue'] = queue;           # dequeue a task
  86.                  (TspAgent) _= TspAgent{self,dist,best,min,1,[X],depth*10};
  87.                  spawn(I-1).
  88.  
  89.     explore(_,_,_,S',_) :- min <= S.                    # bounded cutoff, pruned
  90.     explore([],[],T':[X'|_],S',_) |-                    # best tour so far
  91.         update(T,S+dist[X,0]).                          # wrap around for cycle
  92.     explore(C1',C2',T',S',0) |-                         # level is 0
  93.         qsize' = qsize + 1;                             # task count in queue
  94.         queue' = [task{C1,C2,T,S}|queue].               # enqueue new task
  95.     explore(C1',C2',T',S',D') |-                        # level > 0
  96.         expand(C1,C2,T,S,D);                            # expand cities
  97.         expand(C2,C1,T,S,D).                            # expand cities
  98.  
  99.     expand([],_,_,_,_).                                 # no more cities
  100.     expand([X'|C1'],C2',T':[Y'|Z'],S',D') |-            # expand partial tour
  101.         explore(C1,C2,[X,Y|Z],S+dist[X,Y],D-1);         # go down 1 level
  102.         expand(C1,[X|C2],T,S,D).                        # expand current level
  103.  
  104.     update(_,S') :- min <= S.                           # new result worst than min?
  105.     update(best',min').                                 # no, update globals
  106.  
  107.     ask(best,min).                                      # user enquiry on progress
  108. }
  109.  
  110. TspAgent {
  111.     ?- Tsp::run(queue); work().                         # a working life...
  112.  
  113.     work() :- parent ! update(best, min),               # update parent with result
  114.               parent ! get(X':task{_,_,_,_},B',M');     # get task from parent
  115.               Tsp::update(B,M);                         # update best tour locally
  116.               Tsp::run([X]); work().                    # run task
  117.     work().                                             # ...life ends here
  118. }
  119.  
  120. Root {
  121.     do(dist':$[N',N],depth',count',best,min) :-
  122.         best'  = [];                                    # no best tour yet
  123.         min'   = 65536;                                 # a big number
  124.         qsize' = 0;                                     # singleton queue
  125.         (map) X' = map{N,dist};                         # create map object
  126.         X ! gen(0,[C'|Cs']);                            # generate random weights
  127.         Tsp::run([task{Cs,[],[C],0}]).                  # start run
  128. }
  129.  
  130. /*======================================================================================================
  131.         The  End
  132. ======================================================================================================*/
  133.